home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / misc / dspice0s / extmem.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-11-22  |  4.3 KB  |  141 lines
  1. /* extmem.f -- translated by f2c (version of 3 February 1990  3:36:42).
  2.    You must link the resulting object file with the libraries:
  3.     -lF77 -lI77 -lm -lc   (in that order)
  4. */
  5.  
  6. #include "f2c.h"
  7.  
  8. /* Common Block Declarations */
  9.  
  10. struct {
  11.     doublereal cpyknt;
  12.     integer istack[1], lorg, icore, maxcor, maxuse, memavl, ldval, numblk, 
  13.         loctab, ltab, ifwa, nwoff, ntab, maxmem, memerr, nwd4, nwd8, 
  14.         nwd16;
  15. } memmgr_;
  16.  
  17. #define memmgr_1 memmgr_
  18.  
  19. /* Table of constant values */
  20.  
  21. static integer c__2 = 2;
  22. static integer c__0 = 0;
  23. static integer c__1 = 1;
  24.  
  25. /*<       subroutine extmem(ipntr,ksize) >*/
  26. /* Subroutine */ int extmem_(ipntr, ksize)
  27. integer *ipntr, *ksize;
  28. {
  29.     static integer need, ltab1;
  30.     extern /* Subroutine */ int copy4_();
  31.     static integer isize, jsize;
  32.     extern /* Subroutine */ int memadj_(), errmem_(), comprs_();
  33.     extern logical memptr_();
  34.     extern integer nxtmem_();
  35.     extern /* Subroutine */ int memory_();
  36.     static integer nwords;
  37.     extern integer nxtevn_();
  38.  
  39.     /* Parameter adjustments */
  40.     --ipntr;
  41.  
  42.     /* Function Body */
  43. /*<       implicit double precision (a-h,o-z) >*/
  44. /*<       dimension ipntr(1) >*/
  45. /* spice version 2g.6  sccsid=memmgr 3/15/83 */
  46. /*<       common /memmgr/ cpyknt,istack(1),lorg,icore,maxcor,maxuse,memavl, >*/
  47. /*<      1   ldval,numblk,loctab,ltab,ifwa,nwoff,ntab,maxmem,memerr,nwd4, >*/
  48. /*<      2   nwd8,nwd16 >*/
  49. /*<       logical memptr >*/
  50.  
  51. /* ***  extmem - extend size of existing block */
  52.  
  53.  
  54. /* ...  check for valid pointer */
  55. /*<       if (memptr(ipntr(1))) go to 10 >*/
  56.     if (memptr_(&ipntr[1])) {
  57.     goto L10;
  58.     }
  59. /*<       memerr=5 >*/
  60.     memmgr_1.memerr = 5;
  61. /*<       call errmem(2,memerr,ipntr(1)) >*/
  62.     errmem_(&c__2, &memmgr_1.memerr, &ipntr[1]);
  63. /*<    10 isize=ksize*istack(ltab+5) >*/
  64. L10:
  65.     isize = *ksize * memmgr_1.istack[memmgr_1.ltab + 4];
  66. /* ...  check for valid size */
  67. /*<       if (isize.ge.0) go to 20 >*/
  68.     if (isize >= 0) {
  69.     goto L20;
  70.     }
  71. /*<       memerr=2 >*/
  72.     memmgr_1.memerr = 2;
  73. /*<       call errmem(2,memerr,ipntr(1)) >*/
  74.     errmem_(&c__2, &memmgr_1.memerr, &ipntr[1]);
  75. /* ...  check if enough space already there */
  76. /*<    20 if ((istack(ltab+2)-istack(ltab+3)).ge.isize) go to 40 >*/
  77. L20:
  78.     if (memmgr_1.istack[memmgr_1.ltab + 1] - memmgr_1.istack[memmgr_1.ltab + 
  79.         2] >= isize) {
  80.     goto L40;
  81.     }
  82. /*<       need=nxtevn(isize)-memavl >*/
  83.     need = nxtevn_(&isize) - memmgr_1.memavl;
  84. /*<       if (need.le.0) go to 30 >*/
  85.     if (need <= 0) {
  86.     goto L30;
  87.     }
  88. /* ...  insufficient space -- bump memory size */
  89. /*<       need=nxtmem(need) >*/
  90.     need = nxtmem_(&need);
  91. /*<       icore=icore+need >*/
  92.     memmgr_1.icore += need;
  93. /*<       call memory >*/
  94.     memory_();
  95. /*<       if(memerr.ne.0) call errmem(2,memerr,ipntr(1)) >*/
  96.     if (memmgr_1.memerr != 0) {
  97.     errmem_(&c__2, &memmgr_1.memerr, &ipntr[1]);
  98.     }
  99. /*<       ltab1=ldval-ntab >*/
  100.     ltab1 = memmgr_1.ldval - memmgr_1.ntab;
  101. /*<       istack(ltab1+2)=istack(ltab1+2)+need >*/
  102.     memmgr_1.istack[ltab1 + 1] += need;
  103. /* ...  relocate block entry table */
  104. /*<       nwords=numblk*ntab >*/
  105.     nwords = memmgr_1.numblk * memmgr_1.ntab;
  106. /*<       cpyknt=cpyknt+dble(nwords) >*/
  107.     memmgr_1.cpyknt += (doublereal) nwords;
  108. /*<       call copy4(istack(loctab+1),istack(loctab+need+1),nwords) >*/
  109.     copy4_(&memmgr_1.istack[memmgr_1.loctab], &memmgr_1.istack[
  110.         memmgr_1.loctab + need], &nwords);
  111. /*<       loctab=loctab+need >*/
  112.     memmgr_1.loctab += need;
  113. /*<       ldval=ldval+need >*/
  114.     memmgr_1.ldval += need;
  115. /*<       memavl=memavl+need >*/
  116.     memmgr_1.memavl += need;
  117. /*<       ltab=ltab+need >*/
  118.     memmgr_1.ltab += need;
  119. /* ...  move blocks to make space */
  120. /*<    30 continue >*/
  121. L30:
  122. /*<       call comprs(0,ltab) >*/
  123.     comprs_(&c__0, &memmgr_1.ltab);
  124. /*<       call comprs(1,ltab) >*/
  125.     comprs_(&c__1, &memmgr_1.ltab);
  126. /*<    40 jsize=istack(ltab+3) >*/
  127. L40:
  128.     jsize = memmgr_1.istack[memmgr_1.ltab + 2];
  129. /*<       istack(ltab+3)=istack(ltab+3)+isize >*/
  130.     memmgr_1.istack[memmgr_1.ltab + 2] += isize;
  131. /*<       memavl=memavl-(nxtevn(istack(ltab+3))-nxtevn(jsize)) >*/
  132.     memmgr_1.memavl -= nxtevn_(&memmgr_1.istack[memmgr_1.ltab + 2]) - nxtevn_(
  133.         &jsize);
  134. /*<       call memadj >*/
  135.     memadj_();
  136. /*<       return >*/
  137.     return 0;
  138. /*<       end >*/
  139. } /* extmem_ */
  140.  
  141.